Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d3/dbmail.arc/ML0100.PRG

Text File | 1988-06-19 | 5.8 KB | 215 lines

NOTE ML0100 - ENTER/UPDATE MAILING LIST DATA    9/23/84
SET FORMAT TO SCREEN
SET TALK OFF
USE &FDEV INDEX &FDEV
ERASE
STORE ',,'    TO VAR
STORE 17    TO OFSET
STORE LEN(CODES)    TO MAX
STORE ','    TO DELIM
@ 15,0 SAY 'Enter Default Code Value to Include in Codes Field of New Add Records.'
DO ML0010
STORE VAR    TO DC
GOTO BOTTOM
IF #>0
    STORE RECID+1 TO NRECNO
ELSE
    STORE 1 TO NRECNO
    ENDIF
GOTO 1
IF * .AND. RECID=0
    STORE INST TO DESCR
ELSE
    STORE '                              ' TO DESCR
    ENDIF
@ 23,0
@ 22,0
DO WHILE T
STORE NRECNO TO KEY
@ 23,0 SAY 'ENTER RECORD ID ( "9999"=Return to Menu)  ' GET KEY PICTURE '9999'
READ
IF KEY=9999
    USE
    RELEASE RECNO,NRECNO,KEY,UPDATE,ONFILE,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,F13,F14,N,DESCR,DC
    RELEASE OFSET,MAX,VAR,DELIM,N,OK,EXIT
    RETURN
    ENDIF
STORE KEY    TO RECNO
IF RECNO=0
    STORE NRECNO TO RECNO
    ENDIF
STORE STR(RECNO,4) TO KEY
FIND &KEY
STORE T TO UPDATE,ONFILE
DO CASE
CASE NRECNO=RECNO .AND. #=0
    STORE F TO ONFILE
CASE NRECNO#RECNO .AND. #=0
    ? '    RECORD NOT ON FILE.  <cr> TO ADD,  N=ENTER NEW RECORD ID.'
    WAIT TO KEY
    IF KEY='N'
        STORE F TO UPDATE
    ELSE
        STORE F TO ONFILE
        ENDIF
CASE NRECNO=RECNO .AND. #>0
    ? '    RECORD ALREADY ON FILE.  <cr> TO UPDATE,  N=SKIP THIS RECORD.'
    WAIT TO KEY
    IF KEY='N'
        STORE F TO UPDATE
        ENDIF
ENDCASE
IF UPDATE .AND. ONFILE
    STORE INST    TO F1
    STORE ADD1    TO F2
    STORE ADD2    TO F3
    STORE CITY    TO F4
    STORE STATE    TO F5
    STORE ZIP    TO F6
    STORE TRIM(CODES) TO F7
    STORE CONTACT    TO F8
    STORE TITLE    TO F9
    STORE PHONE    TO F10
    STORE FIRSTNAME    TO F12
    STORE AMT    TO F13
    IF CP
        STORE 'C'    TO F14
    ELSE
        STORE 'P'    TO F14
        ENDIF
    ENDIF
IF UPDATE .AND. .NOT. ONFILE
    STORE '                                        '    TO F1
    STORE '                              '    TO F2,F3,F8,F9,F10,F12
    STORE '                   '    TO F4
    STORE ',,'    TO F7
    STORE '  '    TO F5,F14
    STORE '     '    TO F6
    STORE 0 TO F13
    ENDIF
IF UPDATE
    ERASE
    @ 1,6 SAY 'M A I L   L I S T   N A M E   a n d   A D D R E S S   U P D A T E'
    @ 2,20 SAY DESCR
    @ 3,1 SAY 'Record Type (C/P) ' GET F14 PICTURE '!'
    @ 3,55 SAY 'RECORD ID'
    @ 3,65 SAY RECNO USING '9999'
    IF *.AND.ONFILE
        @ 2,55 SAY '*** RECORD DELETED ***'
        ENDIF
    IF .NOT.ONFILE
        READ
        STORE F14='C'.OR.F14='P'    TO OK
        DO WHILE .NOT.OK
        @ 4,5 SAY 'INVALID RECORD TYPE. MUST BE  C  or  P. Please reenter.'
        @ 3,19 GET F14 PICTURE '!'
        READ
        STORE F14='C'.OR.F14='P'    TO OK
        ENDDO
        @ 4,0
        CLEAR GETS
        ENDIF
    STORE F TO EXIT
    DO WHILE .NOT.EXIT
    @ 5,1 SAY 'Name               ' GET F1 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
    @ 7,1 SAY 'First Line Address ' GET F2 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
    @ 9,1 SAY 'Second Line Address' GET F3 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
    @ 11,1 SAY 'City ' GET F4 PICTURE 'XXXXXXXXXXXXXXXXXXXX'
    @ 11,30 SAY 'State' GET F5 PICTURE '!!'
    @ 11,40 SAY 'Zip Code' GET F6 PICTURE '99999'
IF F14='C'
    @ 13,1 SAY 'Contact Name' GET F8 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
    @ 13,53 SAY 'Title' GET F9 PICTURE 'XXXXXXXXXXXXXXXXXXXX'
ELSE
    @ 13,0
    ENDIF
    @ 15,1 SAY 'Greeting Name(s)    ' GET F12 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
    STORE ' '+$(F10,1,3)+' '+$(F10,4,3)+' '+$(F10,7,4)+' '+$(F10,11,4) TO F11
    @ 17,1 SAY 'Phone               ' GET F11 PICTURE '(XXX)XXX-XXXX:XXXX'
note    mrs-g    @ 17,50 SAY 'Contrib Amount ' GET F13 PICTURE '999999.99'
    READ
    STORE @('"',F1)=0 .AND. @('"',F2)=0 .AND. @('"',F3)=0 .AND. @('"',F4)=0 .AND. @('"',F5)=0 .AND. @('"',F8)=0 .AND. @('"',F9)=0 .AND. @('"',F11)=0 .AND. @('"',F12)=0     TO EXIT
    IF .NOT.EXIT
        @ 19,0 SAY 'ERROR: " found in data field. Remove before proceeding.'
        ENDIF
    IF ONFILE
        STORE F14='C'.OR.F14='P'    TO OK
        DO WHILE .NOT.OK
        @ 4,5 SAY 'INVALID RECORD TYPE. MUST BE  C  or  P. Please reenter.'
        @ 3,19 GET F14 PICTURE '!'
        READ
        STORE F14='C'.OR.F14='P'    TO OK
        ENDDO
        @ 4,0
        CLEAR GETS
        ENDIF
    ENDDO {not exit}
    @ 19,0
    @ 21,0 SAY '--------------    D I S P O S I T I O N   M E N U   --------------------------'
    @ 22,2 SAY '     D  Delete Record  B Bypass Update  R  Recall Record  U  Update   C  Codes'
    @ 23,0 SAY '                                                                               '
    STORE 'U'    TO KEY
    @ 22,0 GET KEY PICTURE '!'
    READ
    IF KEY='C'
        STORE F7    TO VAR
        @ 15,0 SAY 'LABEL SELECTION CODES:                                   '
        @ 16,0
        DO ML0010
        STORE VAR    TO F7
        CLEAR GETS
        @ 19,0
        @ 20,0
        @ 21,0 SAY '--------------    D I S P O S I T I O N   M E N U   --------------------------'
        @ 22,2 SAY '     D  Delete Record  B Bypass Update  R  Recall Record  U  Update           '
        @ 23,0 SAY '                                                                               '
        STORE 'U'    TO KEY
        @ 22,0 GET KEY PICTURE '!'
        READ
        ENDIF
    DO CASE
    CASE KEY='B'
    CASE KEY='D'
        IF ONFILE .AND. .NOT.*
            DELETE
            @ 23,60 SAY 'RECORD DELETED'
            ENDIF
    CASE KEY='R'
        IF ONFILE .AND. *
            RECALL
            @ 23,60 SAY 'RECORD RECALLED'
            ENDIF
    OTHERWISE
        IF .NOT. ONFILE
            APPEND BLANK
            REPLACE RECID WITH RECNO
            STORE RECNO+1 TO NRECNO
            IF F7=',,'
                STORE DC    TO F7
                ENDIF
            ENDIF
        IF F14='P'
            STORE ' '    TO F8,F9
            ENDIF
        REPLACE INST    WITH F1;
            ADD1    WITH F2;
            ADD2    WITH F3
        REPLACE CITY    WITH F4;
            STATE    WITH F5;
            ZIP    WITH F6
        REPLACE CODES    WITH F7;
            CONTACT    WITH F8;
            TITLE    WITH F9
        REPLACE PHONE    WITH $(F11,2,3)+$(F11,6,3)+$(F11,10,4)+$(F11,15,4)
        REPLACE FIRSTNAME WITH F12;
            CP    WITH F14='C';
            AMT    WITH F13
        @ 23,60 SAY 'RECORD UPDATED'
    ENDCASE
    ENDIF
ENDDO
ORD UPDATED'
    ENDCASE
    ENDIF
ENDDO